Water Quality Analysis

Load Packages

library(tidyverse)

## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr     1.1.4     ✔ readr     2.1.5
## ✔ forcats   1.0.0     ✔ stringr   1.5.1
## ✔ ggplot2   3.5.1     ✔ tibble    3.2.1
## ✔ lubridate 1.9.3     ✔ tidyr     1.3.1
## ✔ purrr     1.0.2     
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag()    masks stats::lag()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors

library(ggmap)

## ℹ Google's Terms of Service: <https://mapsplatform.google.com>
##   Stadia Maps' Terms of Service: <https://stadiamaps.com/terms-of-service/>
##   OpenStreetMap's Tile Usage Policy: <https://operations.osmfoundation.org/policies/tiles/>
## ℹ Please cite ggmap if you use it! Use `citation("ggmap")` for details.

library(plotly)

## 
## Attaching package: 'plotly'
## 
## The following object is masked from 'package:ggmap':
## 
##     wind
## 
## The following object is masked from 'package:ggplot2':
## 
##     last_plot
## 
## The following object is masked from 'package:stats':
## 
##     filter
## 
## The following object is masked from 'package:graphics':
## 
##     layout

knitr::opts_chunk$set(
        echo = TRUE,
        warning = FALSE,
  fig.width = 6,
  fig.asp = .6,
  out.width = "90%"
)

theme_set(theme_minimal() +theme(legend.position = "bottom"))

options(
  ggplot2.continuous.color = "viridis",
  ggplot2.continuous.fill = "viridis"
)

scale_color_discrete = scale_colour_viridis_d
scale_fill_discrete = scale_fill_viridis_d

Read in Data

elk = read.csv(file = "./data/elk.csv") |> 
  mutate(date = as.Date(paste(year, month, day, sep = "-")))

water_quality = read.csv(file = "./data/water_quality.csv") |> 
  mutate(date = as.Date(paste(year, month, day, sep = "-"))) |> 
  filter(location_id %in% c("GRTE_SNR01", "GRTE_SNR02", "YELL_LM000.5M", "YELL_YS549.7M", "YELL_MD133.2T", "YELL_MDR"))

Water Quality

• The year, month, and day variables give the time.
• The latitude and longitude give the location.
• characteristic_name gives the type of measurement.
• result_text gives the measurement.

head(water_quality)

##   location_id                                        location_name park_code
## 1  GRTE_SNR01 Snake River at Old Flagg Ranch 1000\x92 Below Bridge      GRTE
## 2  GRTE_SNR01 Snake River at Old Flagg Ranch 1000\x92 Below Bridge      GRTE
## 3  GRTE_SNR01 Snake River at Old Flagg Ranch 1000\x92 Below Bridge      GRTE
## 4  GRTE_SNR01 Snake River at Old Flagg Ranch 1000\x92 Below Bridge      GRTE
## 5  GRTE_SNR01 Snake River at Old Flagg Ranch 1000\x92 Below Bridge      GRTE
## 6  GRTE_SNR01 Snake River at Old Flagg Ranch 1000\x92 Below Bridge      GRTE
##   location_type latitude longitude                activity_id
## 1  River/Stream 44.10177 -110.6716 GRTE_SNR01_060645226G42^01
## 2  River/Stream 44.10177 -110.6716 GRTE_SNR01_060645226G42^01
## 3  River/Stream 44.10177 -110.6716 GRTE_SNR01_060645226G42^01
## 4  River/Stream 44.10177 -110.6716 GRTE_SNR01_060650226G41^01
## 5  River/Stream 44.10177 -110.6716 GRTE_SNR01_060650226G41^01
## 6  River/Stream 44.10177 -110.6716 GRTE_SNR01_060650226G41^01
##                            activity_type activity_start_date year month day
## 1 Quality Control Sample-Equipment Blank          2006-08-14 2006     8  14
## 2 Quality Control Sample-Equipment Blank          2006-08-14 2006     8  14
## 3 Quality Control Sample-Equipment Blank          2006-08-14 2006     8  14
## 4      Quality Control Sample-Trip Blank          2006-08-14 2006     8  14
## 5      Quality Control Sample-Trip Blank          2006-08-14 2006     8  14
## 6      Quality Control Sample-Trip Blank          2006-08-14 2006     8  14
##   characteristic_name result_text       date
## 1        Arsenic mg/l           0 2006-08-14
## 2        Calcium mg/l           0 2006-08-14
## 3      Magnesium mg/l           0 2006-08-14
## 4        Arsenic mg/l           0 2006-08-14
## 5        Calcium mg/l           0 2006-08-14
## 6      Magnesium mg/l           0 2006-08-14

This is an incredibly rich data set. I have only kept the 20 most common quantitative measurements, but there are so many more. I have kept this data set in the long format, because there is very spotty measuring.

water_quality |> 
  group_by(characteristic_name) |> 
  summarize(n = n()) |> 
  arrange(desc(n))

## # A tibble: 20 × 2
##    characteristic_name                      n
##    <chr>                                <int>
##  1 Calcium mg/l                          1369
##  2 Magnesium mg/l                        1369
##  3 Potassium mg/l                        1329
##  4 Sodium mg/l                           1329
##  5 Arsenic mg/l                          1207
##  6 Chloride mg/l                          834
##  7 Sulfur, sulfate (SO4) as SO4 mg/l      834
##  8 Solids, Suspended (TSS) mg/l           802
##  9 Nitrogen, ammonia as N mg/l            759
## 10 Phosphorus as P mg/l                   759
## 11 Temperature, water deg C               745
## 12 Specific conductance uS/cm             742
## 13 Phosphorus, orthophosphate as P mg/l   733
## 14 pH                                     733
## 15 Dissolved oxygen (DO) mg/l             671
## 16 Flow, severity (choice list)           654
## 17 Flow cfs                               627
## 18 Temperature, air deg C                 624
## 19 Turbidity NTU                          356
## 20 Turbidity FNU                          291

calcium = 
  water_quality |> 
  filter(characteristic_name == 'Calcium mg/l') |> 
  mutate(calcium = as.numeric(result_text)) # turning the vector numeric


ggplot(calcium, aes(x = date, y = calcium, color = location_id)) +
  geom_point(alpha = 0.6) +
  labs(
    title = "Scatter Plot of Calcium Levels Over Time", 
    x = "Date", 
    y = "Calcium (mg/l)") +
  theme(legend.position = "right")

arsenic = 
  water_quality |> 
  filter(characteristic_name == 'Arsenic mg/l') |> 
  mutate(arsenic = as.numeric(result_text)) 


ggplot(arsenic, aes(x = date, y = arsenic, color = location_id)) +
  geom_point(alpha = 0.6) +
  labs(
    title = "Scatter Plot of Arsenic Levels Over Time", 
    x = "Date", 
    y = "Arsenic (mg/l)") +
  theme(legend.position = "right")

chloride = 
  water_quality |> 
  filter(characteristic_name == 'Chloride mg/l') |> 
  mutate(chloride = as.numeric(result_text))


ggplot(chloride, aes(x = date, y = chloride, color = location_id)) +
  geom_point(alpha = 0.6) +
  labs(
    title = "Scatter Plot of Chloride Levels Over Time", 
    x = "Date", 
    y = "Chloride (mg/l)") +
  theme(legend.position = "right")

dissolved_oxygen = 
  water_quality |> 
  filter(characteristic_name == 'Dissolved oxygen (DO) mg/l') |> 
  mutate(dissolved_oxygen = as.numeric(result_text)) 


ggplot(dissolved_oxygen, aes(x = date, y = dissolved_oxygen, color = location_id)) +
  geom_point(alpha = 0.6) +
  labs(
    title = "Scatter Plot of Dissolved Oxygen Levels Over Time", 
    x = "Date", 
    y = "Dissolved Oxygen (DO) mg/l") +
  theme(legend.position = "right")

magnesium = 
  water_quality |> 
  filter(characteristic_name == 'Magnesium mg/l') |> 
  mutate(magnesium = as.numeric(result_text)) 


ggplot(magnesium, aes(x = date, y = magnesium, color = location_id)) +
  geom_point(alpha = 0.6) +
  labs(
    title = "Scatter Plot of Magnesium Levels Over Time", 
    x = "Date", 
    y = "Magnesium (mg/l)") +
  theme(legend.position = "right")

nitrogen = 
  water_quality |> 
  filter(characteristic_name == 'Nitrogen, ammonia as N mg/l') |> 
  mutate(nitrogen = as.numeric(result_text)) 


ggplot(nitrogen, aes(x = date, y = nitrogen, color = location_id)) +
  geom_point(alpha = 0.6) +
  labs(
    title = "Scatter Plot of Nitrogen Levels Over Time", 
    x = "Date", 
    y = "Nitrogen (mg/l)") +
  theme(legend.position = "right")

phosphorus = 
  water_quality |> 
  filter(characteristic_name == 'Phosphorus as P mg/l') |> 
  mutate(phosphorus = as.numeric(result_text)) 


ggplot(phosphorus, aes(x = date, y = phosphorus, color = location_id)) +
  geom_point(alpha = 0.6) +
  labs(
    title = "Scatter Plot of Phosphorus Levels Over Time", 
    x = "Date", 
    y = "Phosphorus (mg/l)") +
  theme(legend.position = "right")

potassium = 
  water_quality |> 
  filter(characteristic_name == 'Potassium mg/l') |> 
  mutate(potassium = as.numeric(result_text)) 


ggplot(potassium, aes(x = date, y = potassium, color = location_id)) +
  geom_point(alpha = 0.6) +
  labs(
    title = "Scatter Plot of Potassium Levels Over Time", 
    x = "Date", 
    y = "Potassium (mg/l)") +
  theme(legend.position = "right")

sodium = 
  water_quality |> 
  filter(characteristic_name == 'Sodium mg/l') |> 
  mutate(sodium = as.numeric(result_text)) 


ggplot(sodium, aes(x = date, y = sodium, color = location_id)) +
  geom_point(alpha = 0.6) +
  labs(
    title = "Scatter Plot of Sodium Levels Over Time", 
    x = "Date", 
    y = "Sodium (mg/l)") +
  theme(legend.position = "right")

sulfur = 
  water_quality |> 
  filter(characteristic_name == 'Sulfur, sulfate (SO4) as SO4 mg/l') |> 
  mutate(sulfur = as.numeric(result_text))


ggplot(sulfur, aes(x = date, y = sulfur, color = location_id)) +
  geom_point(alpha = 0.6) +
  labs(
    title = "Scatter Plot of Sulfur Levels Over Time", 
    x = "Date", 
    y = "Sulfur (mg/l)") +
  theme(legend.position = "right")

water_temp = 
  water_quality |> 
  filter(characteristic_name == 'Temperature, water deg C') |> 
  mutate(water_temp = as.numeric(result_text)) 


ggplot(water_temp, aes(x = date, y = water_temp, color = location_id)) +
  geom_point(alpha = 0.6) +
  labs(
    title = "Scatter Plot of Water Temperature Levels Over Time", 
    x = "Date", 
    y = "Water Temperature deg C") +
  theme(legend.position = "right")

water_ph = water_quality |> filter(characteristic_name == ‘pH’) |> mutate(water_ph = as.numeric(result_text))

ggplot(water_ph, aes(x = date, y = water_ph, color = location_id)) + geom_point(alpha = 0.6) + labs( title = “Scatter Plot of pH Levels Over Time”, x = “Date”, y = “pH”) + theme(legend.position = “right”)

water_ph |> mutate(text_label = str_c(“Location:”, location_name, “pH Level:”, result_text)) |> plot_ly( x = ~latitude, y = ~longitude, type = “scatter”, mode = “markers”, color = ~location_name, text = ~text_label, alpha = 0.5, hoverinfo = “text”)

Water Quality Characteristics Over Time

location_data = water_quality |> 
  filter(characteristic_name %in% c("Arsenic mg/l", "Chloride mg/l", "Dissolved oxygen (DO) mg/l", "Magnesium mg/l", "Nitrogen, ammonia as N mg/l", "Phosphorus as P mg/l", "Potassium mg/l", "Sodium mg/l", "Sulfur, sulfate (SO4) as SO4 mg/l", "pH", "Temperature, water deg C")) |> 
  mutate(result_text = as.numeric(result_text))

ggplot(location_data, aes(x = date, y = result_text)) +
  geom_line(aes(color = location_id), size = 0.5) +
  facet_wrap(~ characteristic_name, scales = "free_y") +
  labs(
    title = "Water Quality Over Time",
    x = "Date",
    y = "Characteristic"
  ) +
  scale_colour_viridis_d()

Create a static map plot

using ggmap

from stack exchange

Step 1: Download map

Find the minimum and maximum latitude and longitude of elk’s journey. This will give us the range of map to download.

min_lat = elk |> pull(lat) |> min()
max_lat = elk |> pull(lat) |> max()
rng_lat = abs(min_lat - max_lat)
lowerleftlat = min_lat 
upperrightlat = max_lat 


min_long = elk |> pull(long) |> min()
max_long = elk |> pull(long) |> max()
rng_long = abs(min_long - max_long)
lowerleftlon = min_long - rng_long 
upperrightlon = max_long + rng_long

myLocation <- c(left = lowerleftlon,
                 bottom = lowerleftlat,
                 right = upperrightlon,
                 top = upperrightlat)

register_stadiamaps(key = '29074900-bb6e-4a71-8f91-454c28190f88', write = FALSE)

myMap <- get_stadiamap(
  bbox=myLocation,
  maptype = "stamen_terrain",
  crop=FALSE)

## ℹ © Stadia Maps © Stamen Design © OpenMapTiles © OpenStreetMap contributors.

Ploting Map with Elk Movement

ggmap(myMap) +
geom_path(
  data = elk, 
  aes(x=long, y=lat, color = month))+
  geom_line(alpha = 0) +
  scale_color_gradientn(colours = rainbow(12))

ggplot(
  data = elk, 
  aes(x=long, y=lat)) +
geom_path(alpha = 0.5) +
geom_line(alpha = 0) +
geom_point(
  data = calcium,
  aes(x = longitude, y = latitude, color = 'red')
  )

ggmap(myMap) +
geom_path(
  data = elk, 
  aes(x=long, y=lat, color = month))+
  geom_line(alpha = 0) +
  scale_color_gradientn(colours = rainbow(12)) +
geom_point(
  data = calcium,
  aes(x = longitude, y = latitude)
)